home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / utils.tcl.z / utils.tcl
Text File  |  2002-07-08  |  2KB  |  73 lines
  1. # setmax - set the variable to the maximum of its current value
  2. # or the value of the second argument
  3. # return 1 if the variable's value was changed.
  4. proc setmax {varName value} {
  5.     upvar $varName var
  6.     if {![info exists var] || ($value > $var)} {
  7.     set var $value
  8.     return 1
  9.     } 
  10.     return 0
  11. }
  12. # setmin - set the variable to the minimum of its current value
  13. # or the value of the second argument
  14. # return 1 if the variable's value was changed.
  15. proc setmin {varName value} {
  16.     upvar $varName var
  17.     if {![info exists var] || ($value < $var)} {
  18.     set var $value
  19.     return 1
  20.     } 
  21.     return 0
  22. }
  23. # Assign a set of variables from a list of values.
  24. # If there are more values than variables, they are ignored.
  25. # If there are fewer values than variables, the variables get the empty string.
  26. proc lassign {varList value} {
  27.     if {[string length $value] == 0} {
  28.     foreach var $varList {
  29.         uplevel [list set $var {}]
  30.     }
  31.     } else {
  32.     uplevel [list foreach $varList $value { break }]
  33.     }
  34. }
  35.  
  36. # Delete a list item by value.  Returns 1 if the item was present, else 0
  37. proc ldelete {varList value} {
  38.     upvar $varList list
  39.     if ![info exist list] {
  40.     return 0
  41.     }
  42.     set ix [lsearch $list $value]
  43.     if {$ix >= 0} {
  44.     set list [lreplace $list $ix $ix]
  45.     return 1
  46.     } else {
  47.     return 0
  48.     }
  49. }
  50.  
  51. proc makedir { pathname } {
  52.     file mkdir $pathname
  53. }
  54.  
  55. proc Visibility_Wait {win} {
  56.     catch {tkwait visibility $win}
  57. }
  58. proc File_Delete {args} {
  59.     global tcl_version
  60.     if {$tcl_version >= 7.6} {
  61.     foreach f $args {
  62.         if [file isdirectory $f] {
  63.         error "Should not delete directories this way"
  64.         }
  65.         file delete -force $f
  66.     }
  67.     } else {
  68.     if {[llength $args]} {
  69.         eval {exec /bin/rm -f} $args
  70.     }
  71.     }
  72. }
  73.